home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / lysrc.zip / YACCMSGS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-24  |  5KB  |  152 lines
  1.  
  2. unit YaccMsgs;
  3.  
  4. (* 2-5-91 AG *)
  5.  
  6. (* Copyright (c) 1990,91 by Albert Graef, Schillerstr. 18,
  7.    6509 Schornsheim/Germany
  8.    All rights reserved *)
  9.  
  10. interface
  11.  
  12. (* TP Yacc message and error handling module 2-5-91 AG
  13.    Note: this module should be USEd by any module using the heap during
  14.          initialization, since it installs a heap error handler (which
  15.          terminates the program with fatal error `memory overflow'). *)
  16.  
  17. var errors, warnings : Integer;
  18.   (* - current error and warning count *)
  19. procedure error(msg : String);
  20.   (* - print current input line and error message (pos denotes position to
  21.        mark in source file line) *)
  22. procedure warning(msg : String);
  23.   (* - print warning message *)
  24. procedure fatal(msg : String);
  25. (* - writes a fatal error message, erases Yacc output file and terminates
  26.      the program with errorlevel 1 *)
  27.  
  28. const
  29.  
  30. (* sign-on and usage message: *)
  31.  
  32. sign_on = 'TP Yacc Version 3.0a [May 92], Copyright (c) 1990-92 Albert Graef';
  33. usage   = 'Usage: YACC [options] yacc-file[.Y] [output-file[.PAS]]';
  34. options = 'Options: /v verbose, /d debug';
  35.  
  36. (* command line error messages: *)
  37.  
  38. invalid_option                  = 'invalid option ';
  39. illegal_no_args                 = 'illegal number of parameters';
  40.  
  41. (* syntax errors: *)
  42.  
  43. open_comment_at_eof             = '101: open comment at end of file';
  44. missing_string_terminator       = '102: missing string terminator';
  45. rcurl_expected                  = '103: %} expected';
  46. rbrace_expected                 = '104: } expected';
  47. rangle_expected                 = '105: > expected';
  48. ident_expected                  = '106: identifier expected';
  49. error_in_def                    = '110: error in definition';
  50. error_in_rule                   = '111: error in rule';
  51. syntax_error             = '112: syntax error';
  52. unexpected_eof                  = '113: unexpected end of file';
  53.  
  54. (* semantic errors: *)
  55.  
  56. nonterm_expected                = '201: nonterminal expected';
  57. literal_expected                = '202: literal expected';
  58. double_tokennum_def             = '203: literal already defined';
  59. unknown_identifier              = '204: unknown identifier';
  60. type_error                      = '205: type error';
  61. range_error                     = '206: range error';
  62. empty_grammar             = '207: empty grammar?';
  63.  
  64. (* fatal errors: *)
  65.  
  66. cannot_open_file         = 'FATAL: cannot open file ';
  67. write_error                     = 'FATAL: write error';
  68. mem_overflow             = 'FATAL: memory overflow';
  69. intset_overflow         = 'FATAL: integer set overflow';
  70. sym_table_overflow         = 'FATAL: symbol table overflow';
  71. nt_table_overflow         = 'FATAL: nonterminal table overflow';
  72. lit_table_overflow         = 'FATAL: literal table overflow';
  73. type_table_overflow         = 'FATAL: type table overflow';
  74. prec_table_overflow         = 'FATAL: precedence table overflow';
  75. rule_table_overflow         = 'FATAL: rule table overflow';
  76. state_table_overflow         = 'FATAL: state table overflow';
  77. item_table_overflow         = 'FATAL: item table overflow';
  78. trans_table_overflow         = 'FATAL: transition table overflow';
  79. redn_table_overflow         = 'FATAL: reduction table overflow';
  80.  
  81. implementation
  82.  
  83. uses YaccBase;
  84.  
  85. procedure position(var f : Text;
  86.             lineNo : integer;
  87.             line : String;
  88.             pos : integer);
  89.   (* writes a position mark of the form
  90.      lineno: line
  91.                ^
  92.      on f with the caret ^ positioned at pos in line
  93.      a subsequent write starts at the next line, indented with tab *)
  94.   var
  95.     line1, line2 : String;
  96.   begin
  97.     (* this hack handles tab characters in line: *)
  98.     line1 := intStr(lineNo)+': '+line;
  99.     line2 := blankStr(intStr(lineNo)+': '+copy(line, 1, pos-1));
  100.     writeln(f, line1);
  101.     writeln(f, line2, '^');
  102.     write(f, tab)
  103.   end(*position*);
  104.  
  105. procedure error(msg : String);
  106.   begin
  107.     inc(errors);
  108.     writeln;
  109.     position(output, lno, line, cno-tokleng);
  110.     writeln(msg);
  111.     writeln(yylst);
  112.     position(yylst, lno, line, cno-tokleng);
  113.     writeln(yylst, msg);
  114.     if ioresult<>0 then ;
  115.   end(*error*);
  116.  
  117. procedure warning(msg : String);
  118.   begin
  119.     inc(warnings);
  120.     writeln;
  121.     position(output, lno, line, cno-tokleng);
  122.     writeln(msg);
  123.     writeln(yylst);
  124.     position(yylst, lno, line, cno-tokleng);
  125.     writeln(yylst, msg);
  126.     if ioresult<>0 then ;
  127.   end(*warning*);
  128.  
  129. procedure fatal(msg : String);
  130.   begin
  131.     writeln;
  132.     writeln(msg);
  133.     close(yyin); close(yyout); close(yylst); erase(yyout);
  134.     halt(1)
  135.   end(*fatal*);
  136.  
  137. {$F+}
  138. function heapErrorHandler ( size : Word ) : Integer;
  139. {$F-}
  140.   begin
  141.     if size>0 then
  142.       fatal(mem_overflow) (* never returns *)
  143.     else
  144.       heapErrorHandler := 1
  145.   end(*heapErrorHandler*);
  146.  
  147. begin
  148.   errors := 0; warnings := 0;
  149.   (* install heap error handler: *)
  150.   heapError := @heapErrorHandler;
  151. end(*YaccMsgs*).
  152.